home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / faq / drcl96d.zip / COUNTJOK.BAS < prev    next >
BASIC Source File  |  1991-06-06  |  2KB  |  64 lines
  1. 10 'FROM DR. SICKOFF'S RESEARCH LABS
  2. 20 'A QUICKBASIC 3.0 PROGRAM TO READ DRSICKDB.DAT AND COUNT #JOKE CATEGORIES
  3. 30 'AND #JOKES.
  4. 40 'IF YOU RUN THE PROGRAM WITH A PARAMETER, IT WILL BE TAKEN AS AN ALTERNATE
  5. 50 'JOKE DATA FILE NAME.
  6. 60 '
  7. 70 IF 0=1 THEN 630 'PROGRAM LENGTH
  8. 80 '
  9. 90 KEY OFF:WIDTH 80:SCREEN 0:COLOR 14,0,0:CLS
  10. 100 TRUE=1=1:FALSE=NOT TRUE
  11. 110 '
  12. 120 'GET FILE NAME FROM COMMAND LINE
  13. 130 F$=COMMAND$:IF F$="" THEN F$="DRSICKDB.DAT"
  14. 140 IF INSTR(F$,".")<1 THEN F$=F$+".DAT"
  15. 150 '
  16. 160 'F1 WILL ABORT THE PROGRAM
  17. 170 ON KEY (1) GOSUB 200:KEY (1) ON
  18. 180 GOTO 220
  19. 190 '
  20. 200 GOTO 550
  21. 210 '
  22. 220 'OPEN THE DATA FILE
  23. 230 OPEN "I",#1,F$
  24. 240 '
  25. 250 'GO THROUGH IT COUNTING JOKES & CATEGORIES
  26. 260 NJOKES=0:NCATS=0:R.CAT=CSRLIN:C.CAT=1
  27. 270 '
  28. 280 IF EOF(1) GOTO 500
  29. 290 LINE INPUT #1,L$
  30. 300 '
  31. 310 IF LEFT$(L$,1)<>"-" THEN 440
  32. 320 IF LEN(L$)<2 THEN 440 'CATEGORY NAME MUST BE AT LEAST ONE CHAR.
  33. 330 WHILE MID$(L$,2,1)=" ":L$=MID$(L$,2,LEN(L$))
  34. 340 IF LEN(L$)<2 THEN 440
  35. 350 WEND
  36. 360 '
  37. 370 NCATS=NCATS+1
  38. 380 GOSUB 580
  39. 390 IF R.CAT=24 THEN LOCATE 24,80:PRINT ELSE LOCATE R.CAT+1,1 'FORCE SCREEN SCROLL
  40. 400 PRINT USING "###. ";NCATS;
  41. 410 PRINT MID$(L$,2,LEN(L$));:R.CAT=CSRLIN:C.CAT=POS(0):PRINT SPACE$(81-POS(0));
  42. 420 NJOKES.CAT=0
  43. 430 '
  44. 440 IF LEFT$(L$,1)<>"=" THEN 280
  45. 450 NJOKES=NJOKES+1:NJOKES.CAT=NJOKES.CAT+1
  46. 460 LOCATE 1,81-11:PRINT USING "JOKES:#####";NJOKES;
  47. 470 '
  48. 480 GOTO 280
  49. 490 '
  50. 500 GOSUB 580:SOUND 1555,1:SOUND 0,.1
  51. 510 '
  52. 520 'PAUSE TIL A KEY IS PRESSED
  53. 530 WHILE INKEY$<>"":WEND:WHILE INKEY$="":WEND
  54. 540 '
  55. 550 'NOW EXIT
  56. 560 CLOSE:COLOR 7,0,0:CLS:END
  57. 570 '
  58. 580 'LITTLE SUBR. TO DISPLAY #JOKES IN CURRENT CATEGORY
  59. 590 IF NCATS<=1 THEN 610
  60. 600 LOCATE R.CAT,C.CAT:PRINT NJOKES.CAT;:PRINT SPACE$(81-POS(0));
  61. 610 RETURN
  62. 620 '
  63. 630 END 'OF PROGRAM
  64.